home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 010 / scope.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1984-04-24  |  4.6 KB  |  199 lines
  1. 10  ' N O T E       N O T E       N O T E       N O T E
  2. 20  '
  3. 30  ' See important comments at the end of this program.
  4. 40  '
  5. 50  KEY OFF
  6. 60  DIM SCRN%(8,4)
  7. 70  SCREEN 0,0
  8. 80  LOCATE 1,1,0
  9. 90  GOSUB 1080      'INITIALIZE ARRAY
  10. 100  GOSUB 760      'PRINT MENU ON SCREEN
  11. 110  GOSUB 1390     'GO ASK USER WHAT HE WANTS TO DO
  12. 120  GOSUB 1790     'GO SEE WHAT HE SAID TO DO
  13. 130  GOSUB 1580     'SWITCH TO COLOR DISPLAY
  14. 140  GOSUB 670
  15. 150  IF SCRN%(7,2)>1 THEN SCREEN 1,1 ELSE SCREEN 1,0
  16. 160  IF SCRN%(5,2)>1 THEN COLOR 0,CINT(RND) ELSE COLOR CINT(RND * 15),CINT(RND)
  17. 170  CLS
  18. 180  '
  19. 190  '
  20. 200  X1=(RND * 50)+1
  21. 210  X2=(RND * 50)+1
  22. 220  Y1=RND * X1
  23. 230  Y2=RND * X2
  24. 240  GOTO 360
  25. 250  '
  26. 260  IF INT(RND * 11) = 5 THEN GOSUB 670
  27. 270  CC$=INKEY$
  28. 280  IF LEN(CC$)=0 THEN 310
  29. 290  IF CC$=CHR$(27) THEN GOSUB 1680: GOTO 100
  30. 300  IF CC$=" " THEN 160
  31. 310  IF INT(RND * 250) = 125 THEN 160
  32. 320  X1=(X1+XX) MOD 110
  33. 330  Y1=(Y1+YX) MOD 110
  34. 340  X2=(X2+XY) MOD 110
  35. 350  Y2=(Y2+YY) MOD 110
  36. 360  Y1=-Y1
  37. 370  Y2=-Y2
  38. 380  GOSUB 510
  39. 390  X1=-X1
  40. 400  X2=-X2
  41. 410  GOSUB 510
  42. 420  Y1=-Y1
  43. 430  Y2=-Y2
  44. 440  GOSUB 510
  45. 450  X1=-X1
  46. 460  X2=-X2
  47. 470  GOSUB 510
  48. 480  GOTO 260
  49. 490  '
  50. 500  '
  51. 510  ON I% GOTO 520,560,590,630
  52. 520  LINE((X1+100)*35/24,Y1+100)-((X2+100)*35/24,Y2+100),CO
  53. 530  LINE((Y1+100)*35/24,X1+100)-((Y2+100)*35/24,X2+100),CO
  54. 540  RETURN
  55. 550  '
  56. 560  LINE((X1+100)*35/24,Y1+100)-((X2+100)*35/24,Y2+100),CO,B
  57. 570  RETURN
  58. 580  '
  59. 590  LINE((X1+100)*35/24,Y1+100)-((X2+100)*35/24,Y2+100),CO
  60. 600  LINE((Y1+100)*35/24,X1+100)-((Y2+100)*35/24,X2+100),CO,B
  61. 610  RETURN
  62. 620  '
  63. 630  CIRCLE (X1+150,Y1+100),ABS(X2),CO
  64. 640  RETURN
  65. 650  '
  66. 660  '
  67. 670  XX=(RND * 11)-5
  68. 680  XY=(RND * 11)-5
  69. 690  YX=(RND * 11)-5
  70. 700  YY=(RND * 11)-5
  71. 710  CO=CINT(RND *3)
  72. 720  RANDOMIZE(VAL(RIGHT$(TIME$,2)))
  73. 730  RETURN
  74. 740  '
  75. 750  '
  76. 760  VL$=CHR$(179)
  77. 770  HL$=CHR$(196)
  78. 780  UR$=CHR$(191)
  79. 790  LR$=CHR$(217)
  80. 800  UL$=CHR$(218)
  81. 810  LL$=CHR$(192)
  82. 820  CLS
  83. 830  LOCATE ,,0
  84. 840  PRINT TAB(15) "KALEIDOSCOPE"
  85. 850  LOCATE 4
  86. 860  PRINT "Foreground" TAB(15) UL$ "Lines" TAB(35) UR$
  87. 870  PRINT TAB(15) VL$ "Boxes" TAB(35) VL$
  88. 880  PRINT TAB(15) VL$ "Lines and Boxes" TAB(35) VL$
  89. 890  PRINT TAB(15) LL$ "Circles" TAB(35) LR$
  90. 900  LOCATE 10
  91. 910  PRINT "Background" TAB(15) UL$ "Random Color" TAB(32) UR$
  92. 920  PRINT TAB(15) LL$ "Black" TAB(32) LR$
  93. 930  LOCATE 14
  94. 940  PRINT "Mode" TAB(15) UL$ "Color" TAB(33) UR$
  95. 950  PRINT TAB(15) LL$ "Black & White" TAB(33) LR$
  96. 960  LOCATE 18
  97. 970  PRINT "Select one from each group"
  98. 980  PRINT "Move cursor with RETURN key"
  99. 990  PRINT "Press SPACE to execute KALEIDOSCOPE"
  100. 1000  PRINT "Press ESC to EXIT"
  101. 1010  LOCATE 24,1
  102. 1020  PRINT "While running, SPACE bar will restart";
  103. 1030  LOCATE 25,1
  104. 1040  PRINT "ESC will return to this menu";
  105. 1050  RETURN
  106. 1060  '<UNK! {FF00}>LLIST9.<UNK! {0004}>'
  107. 1080  FOR I%=0 TO 3
  108. 1090  FOR J%=0 TO 7
  109. 1100  READ SCRN%(J%,I%)
  110. 1110  NEXT J%,I%
  111. 1120  RETURN
  112. 1130  '
  113. 1140  '
  114. 1150  FOR I%=0 TO 7
  115. 1160  LOCATE SCRN%(I%,0),SCRN%(I%,1)
  116. 1170  IF SCRN%(I%,2)=0 THEN PRINT " "
  117. 1180  IF SCRN%(I%,2)=1 THEN COLOR 0,7: PRINT " ": COLOR 7,0
  118. 1190  IF SCRN%(I%,2)=2 THEN COLOR 0,7: PRINT "X": COLOR 7,0
  119. 1200  IF SCRN%(I%,2)=3 THEN PRINT "X"
  120. 1210  NEXT I%
  121. 1220  RETURN
  122. 1230  '
  123. 1240  '
  124. 1250  IF SCRN%(CURS%,2)=1 THEN SCRN%(CURS%,2)=0 ELSE SCRN%(CURS%,2)=3
  125. 1260  CURS%=CURS%+1
  126. 1270  IF CURS%=8 THEN CURS%=0
  127. 1280  IF SCRN%(CURS%,2)=0 THEN SCRN%(CURS%,2)=1 ELSE SCRN%(CURS%,2)=2
  128. 1290  RETURN
  129. 1300  '
  130. 1310  '
  131. 1320  FOR I%=0 TO 7
  132. 1330  IF SCRN%(I%,3)=SCRN%(CURS%,3) THEN SCRN%(I%,2)=0
  133. 1340  NEXT I%
  134. 1350  SCRN%(CURS%,2)=2
  135. 1360  RETURN
  136. 1370  '
  137. 1380  '
  138. 1390  GOSUB 1150
  139. 1400  CC$=""
  140. 1410  WHILE LEN(CC$)<>1
  141. 1420  CC$=INKEY$
  142. 1430  WEND
  143. 1440  IF CC$=CHR$(13) THEN GOSUB 1250: GOSUB 1150
  144. 1450  IF (CC$="x") OR (CC$="X") THEN GOSUB 1320: GOSUB 1150
  145. 1460  'IF NO MONOCHROME DISPLAY CHANGE LOCATE ,,1,12,13 TO LOCATE ,,1,7  *****
  146. 1470  IF CC$=CHR$(27) THEN GOSUB 1680: KEY ON: LOCATE ,,1,12,13: CLS: END
  147. 1480  IF CC$=" " THEN RETURN
  148. 1490  GOTO 1390
  149. 1500  '
  150. 1510  '
  151. 1520  DATA 4,5,6,7,10,11,14,15
  152. 1530  DATA 22,22,32,24,29,22,22,30
  153. 1540  DATA 2,0,0,0,3,0,3,0
  154. 1550  DATA 1,1,1,1,2,2,3,3
  155. 1560  '
  156. 1570  '
  157. 1580  'RETURN  'ACTIVATE THIS STATEMENT IF NO MONOCHROME DISPLAY
  158. 1590  DEF SEG=&H41
  159. 1600  POKE 0,(PEEK(0) AND &HCF) OR &H20
  160. 1610  DEF SEG
  161. 1620  SCREEN 0
  162. 1630  WIDTH 40
  163. 1640  SCREEN 1,0
  164. 1650  RETURN
  165. 1660  '
  166. 1670  '
  167. 1680  'SCREEN 0,0  'ACTIVATE THIS STATEMENT IF NO MONOCHROME DISPLAT
  168. 1690  'RETURN 'ACTIVATE THIS STATEMENT IF NO MONOCHROME DISPLAY
  169. 1700  DEF SEG=&H41
  170. 1710  POKE 0,(PEEK(0) OR &H30)
  171. 1720  DEF SEG
  172. 1730  SCREEN 0
  173. 1740  WIDTH 80
  174. 1750  LOCATE 1,1,0
  175. 1760  RETURN
  176. 1770  '
  177. 1780  '
  178. 1790  IF SCRN%(0,2)>1 THEN I%=1
  179. 1800  IF SCRN%(1,2)>1 THEN I%=2
  180. 1810  IF SCRN%(2,2)>1 THEN I%=3
  181. 1820  IF SCRN%(3,2)>1 THEN I%=4
  182. 1830  RETURN
  183. 1840  '         N O T E        N O T E
  184. 1850  'Activate/deactivate statements commented above depending on whether
  185. 1860  'or not you have a monochrome display. The statement numbers are
  186. 1870  'listed below in an ON statement incase someone renumbers this thing.
  187. 1880  ON I% GOTO 1460,1580,1680,1690
  188. 1890  '
  189. 1900  'If from time to time it appears that the program is not working, it may b
  190. 1910  'that it is painting with the same color as the background.
  191. 1920  '
  192. 1930  'Feel free to copy this program and pass it on to a friend, lover, etc.,
  193. 1940  'but lets see how many hands this program passes through. Before you
  194. 1950  'copy it, please add your name to the bottom of the list below.
  195. 1960  'This program written for the IBM PC by
  196. 1970  ' Bill Decker  4 Sherwood Dr. Endicott, N. Y. 13760
  197. 1980  ' Barry Shiffrin 2309 Acorn Dr. Vestal, NY  13850
  198. 1990  ' Loren D. Jones, 1339 7th Ave. S., Fargo, ND 58103 (RBBS-PC 701-293-5973)
  199.